perm filename P2S.OLD[LIB,LCS] blob
sn#089341 filedate 1974-02-23 generic text, type T, neo UTF8
00100 DIMENSION I(70),J(70),KS(7),NQ(4)
00200 DATA KS/'B','E','A','D','G','C','F'/,NQ/'CLAR','BUZZ',
00210 1'BRIT','TOOT'/
00300 1 FORMAT(' TYPE FILE NAME ',$)
00400 2 FORMAT(A5)
00500 21 FORMAT(' TYPE OUTPUT NAME ',$)
00600 TYPE 1
00700 NR=1
00800 NEXT=0
00900 ACCEPT 2,NM
01000 TYPE 21
01100 ACCEPT 2,NMO
01200 CALL OFILE(21,NMO)
01300 WRITE(21,60)
01400 CALL IFILE(1,NM)
01500 300 WRITE(21,70)NQ(NR)
01600 TYPE 71,NQ(NR)
01700 70 FORMAT(A5,'/P3 NO;')
01800 71 FORMAT(1XA5,'/P3 NO;')
01900 30 READ(1,3)N,I
02000 3 FORMAT(I,70A1)
02100 KN=0
02200 M=1
02300 MORE=0
02400 DO 37 K=1,70
02500 37 IF(I(K).EQ.'*')MORE=-1
02600 36 DO 4 K=M,70
02700 NN=I(K)
02800 IF(NN.NE.'R'.AND.NN.NE.'X')GO TO 31
02900 C FINDS 'REP' AND 'X'
03000 DO 32 MM=K,70
03100 NN=I(MM)
03200 IF(NN.NE.'/'.AND.NN.NE.'*'.AND.NN.NE.';')GO TO 32
03300 M=MM+1
03400 GO TO 36
03500 32 CONTINUE
03600 31 IF(NN.GE.'0'.AND.(K.EQ.1.OR.I(K-1).GT.0))GO TO 34
03700 C FINDS TIME SIG.
03800 33 IF(NN.NE.'K')GO TO 35
03850 KQ=1
03900 334 KN=(I(K+KQ)-'0')/536870912
04000 C FINDS THE NUMBER OF SHARPS OR FLATS
04050 KQ=K+KQ+1
04100 KAC=I(KQ)
04150 I(KQ)=' '
04200 GO TO 34
04210 333 KQ=0
04220 GO TO 334
04300 C CATCHES TREB, BASS,ALTO,TENOR CLEFS AND MEASURE LINES.
04400 35 IF((NN.EQ.'B'.AND.I(K+1).EQ.'A').OR.(NN.EQ.'A'.AND.I(K+1).
04500 1 EQ.'L'))GO TO 34
04600 IF(NN.NE.'T'.AND.NN.NE.'M'.AND.NN.NE.'-')GO TO 4
04650 34 IF(I(K+1).LT.0)GO TO 333
04675 C FOR NEW KEY SIG. (2F OR 3S, ETC.)
04700 IF(I(K-1).EQ.'/')I(K-1)=' '
04800 DO 44 JJ=K,70
04900 IF(I(JJ).EQ.'*'.OR.I(JJ).EQ.';')GO TO 46
05000 50 IF(I(JJ).EQ.'/')GO TO 46
05100 44 CONTINUE
05200 46 JJ=JJ-K
05250 IF(JJ.EQ.0)GO TO 4
05300 DO 45 N=K,70-JJ
05400 45 I(N)=I(N+JJ)
05500 GO TO 36
05600 4 CONTINUE
05700 K=0
05800 90 K=K+1
05900 NN=I(K)
06000 IF(KN.EQ.0)GO TO 11
06100 IF(NN.LT.'A'.OR.NN.GT.'G')GO TO 9
06200 55 K=K+1
06300 LN=I(K)
06400 IF(LN.NE.'N')GO TO 51
06500 I(K)=I(K-1)
06600 I(K-1)=' '
06700 GO TO 9
06800 51 IF(LN.EQ.'S'.OR.LN.EQ.'F')GO TO 9
06900 M=1
07000 MM=KN
07100 MMM=1
07200 IF(KAC.EQ.'F')GO TO 52
07300 MM=8-KN
07400 MMM=-1
07500 M=7
07600 52 DO 54 N=M,MM,MMM
07700 IF(NN.NE.KS(N))GO TO 54
07800 DO 53 NN=70,K+1,-1
07900 53 I(NN)=I(NN-1)
08000 C OPENS UP SPACE FOR 'F' OR 'S'
08100 I(K)=KAC
08200 K=K+1
08300 GO TO 9
08400 54 CONTINUE
08500 GO TO 9
08600 11 IF(I(K).EQ.' ')GO TO 9
08700 IF(I(K).NE.'/')I(K-1)='/'
08800 GO TO 10
08900 9 IF(K.LT.70)GO TO 90
09000 6 FORMAT(70A1)
09100 64 FORMAT(1X70A1)
09200 61 FORMAT(' P2 RHY/',70A1)
09300 65 FORMAT('P2 RHY/',70A1)
09400 62 FORMAT('END;')
09500 63 FORMAT(' END;'/)
09600 60 FORMAT('QQQ')
09650 10 DO 101 K=1,70
09655 101 IF(I(K).NE.' '.AND.I(K).NE.'/')GO TO 103
09657 103 K=K-1
09660 DO 102 JJ=1,70-K
09665 102 I(JJ)=I(JJ+K)
09700 IF(MORE)GO TO 100
09800 WRITE(21,6)I
09900 TYPE 64,I
10000 GO TO 30
10100 100 DO 7 K=1,70
10200 IF(I(K).NE.'*')GO TO 7
10300 I(K)='/'
10400 I(K+1)='F'
10500 I(K+2)='I'
10600 I(K+3)='N'
10700 I(K+4)='*'
10800 GO TO 8
10900 7 CONTINUE
11000 8 I(70)=';'
11100 WRITE(21,6)I
11200 TYPE 64,I
11300 5 READ(1,3)N,J
11400 J(62)=';'
11500 IF(MORE.LE.0)GO TO 83
11600 TYPE 61,I,J
11700 WRITE(21,62)I,J
11800 GO TO 84
11900 83 TYPE 61,J
12000 TYPE 63
12100 80 WRITE(21,65)J
12200 84 WRITE(21,62)
12300 CCC IF(NEXT)CALL EXIT
12400 NR=NR+1
12500 NEXT=-1
12600 DO 81 K=1,3
12700 81 READ(1,2,END=82)N
12800 GO TO 300
12900 82 END